PPPPPPPPPPPP LLL IIIIIIII1 RRRRRRRRRRRR TITTTTTTTTTTTITT LLL 

PPPPPPPPPPPP LLL LIIIIII11 RRRRRRRRRRRR TTTTTTTTTTTTTITT § LLL 

PPPPPPPPPPPP LLL LIIIIII11 RRRRRRRRRRRR TTTTTTTTTTTTTTT «LLL 

PPP PPP LLL II] RER RRR TTT LLL 

PRP PPP LLL III one RRR TTT LLL 

PPP PPP LLL II] RRR RRR TTT LLL 

PPP PPP LLL II] ROR RRR TTT LLL 
PPP PPP LLL II] RRR RRR TTT LLL 

PPP PPP LLL II] dd TTT LLL 

PPPPPPPPPPPP LLL II] RRRRRRRRRRRR TTT LLL 

PPPPPPPPPPPP LLL III RRRRRRRRRRRR TTT LLL 

PPPPPPPPPPPP LLL II] RRRRRRRRRRRR TTT LLL 

PRP LLL II] RRR RRR TTT LLL 

PPP LLL II] RRR RRR TTT LLL 

BPP LLL II] RRR RRR TTT LLL 

PPP LLL II] RRR RRR TTT LLL 

PRP Lil II] AER RRR TTT LLL 
PPP LLL I]] FOR RRR TTT LLL 
PPP LELLLLELLLLLLLL IIIIIII11 RRR PRR TTT LLLLLLLLLLLLLLL 

PPP LELLLLELLLLLLLL IIIIIII11 RAR RRR TTT LLLLLLLLELLLLLLE | 
PPP LLLLLLLLLLLLLLL IIIIII111 RRR RRR TTT LELLLLELLLLLLLL 


ad 
nn 


in 
ix 
13 


Ot oe Ps be bt bb be bt 


bo bs be oe as es | ell onl coed 


PRPPZ PPPPVPP PPP -PPPPPPPPPPPPPPPP? 


osenenes 


227222222 


— sienenasiantipitiatitiged 


8 i 
 weF ILE**1DeePLIFORRAT 
PPPPPPPP LL III] FFFFFFFFFE 000000 RRRRRRRR MM MM AAAAAA TITTTTITTT 
PPPPPPPP LL III! FFFFFFFFFF 000000 RRRRRRRR MM MM AAAAAA TTTTTTTITT 
PP PP LL I] FF 00 OO RR RR MMMM MMMM AA AA TT 
PP pr tA I] FF 00 OO RR RR MMMM MMMM AA AA TT 
PP PP LL I] FF 00 0O RR RR MM MM AA AA TT 
PP PP LL I] FF 00 OO RR RR MM MM MM AA AA TT 
PPPPPPPP LL I] FFFFFFFF 00 OO RRRRRRRR MM MM AA AA TT 
PPPPPPPP LL I] FFFFFFFF 00 00 RRRRRRRR MM MM AA Ab TT 
PP LL I] FF 00 OO RR RR MM MM AAAAAAAAAA TT 
PP tL I] FF 00 OO RR RR MM MM AAAAAAAAAA TT 
PP LL I] FF 00 0O RR RR MM MM AA AA TT eoee 
PP LL I] FF 00 00 RR RR MM MM AA AA TT eee 
PP LLLLLLLLLL III] FF 000000 RR RR MM MM AA AA TT cose 
PP LLLLLLLLLL III] FF 000000 RR RR MM MM AA AA TT cece 
LL IIIIII SSSSSSSS 
LL 111] SSSSSSSS 
LL I] SS 
LL I] SS 
LL I] SS 
LL I] SS 
LL I] SSSSSS 
LL I] SSSSSS 
LL I] SS 
LL I] SS 
LL li SS 
LL I] SS 
LLLLLLLLLL T1111] SSSSSSSS 
LLLLLLLLLL 11111 SSSSSSSS 
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title pli$f 


$format 
eident /1-006/ 


Beets 
mmmm 
aaana 


MeSSRAREAASLALLLALLESLERASASALALELE RS RSA SERA RARARA SAAS ASRRAA ARRAS SERA RA RARE A DS SD | 
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facility: 
VAX/VMS PL1 runtime Library 
abstract: 
This module contains the pl1 runtime routines for getting the next 
format item in a format List. 
author: c. spitz 28-nov-79 
modified: 
1-002 Chip Nylander 7-September-1982 
Rodi tig GETCOL to conform to ANSI X3.53 page 259 
tep 1.2.5.2.5: if a column request cannot be satisfied for 
or reason, do an implicit getsh ip: if the column request can 


now be satisfied, perform the column positioning, otherwise 
do nothing. 


1-003 Bill Matthews 29-September-1982 


ee Oe. ee eer eee aan ee ee 


Se Oe Se Se Be Oe Se Se Ge Be Be Se Se Se Se Se Se Se Ge Ge Ge Ge Fe Se Se Ge 


PUPP BB BBE EE ENNIO PININININININN ee oe oe oe Oe ee er 


Coooooeoo 
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o 


D1 
PLISFORMAT 16-SEP-1984 02:18:05 VAX/VMS Macro V04-00 : 
1-006 green obe Siege FRCIN Te eae ToLVeoacer.mars1 2% 


Invoke macros $defdat and rtshare instead of $defopr and share. 
1-004 Chip Nylander 03-Februaruy-1983 


Save the parent frame pointer in R1 instead of RO when calling 
an expression routine. 


1-005 Chip Nylander 23-February-1983 


Make fixed-point edited output of treet as binary values . 
round instead of truncate, per the ANSI Standard and our 
own published documentation. 


1-006 Chip Nylander 08-August-1983 


Solve problem with uplevel references to automatic variables 
in remote formats by using the pocens pointer of the frame 
containing the remote format. Use the parent pointer instead 
of -4(fp) for all vfe calls. 


Oooo 


pee ee ale lolol ololeoleleloleleleleleleleleleleleleleleolelolelelololololo) 


: external definitions 


30300000 09 00 00 09 00 09 09 09 09 SII NI NII INN INIOAAAAAAAAOAOUI 
FW OS OONAUE WN 0 ODNAUE WN CO OONAOUSWN—Owcn 


$defstr sdefine stream block offsets 
$defdat_ define data types 
$defcvtind sdefine convert indices 
$deffcb sdefine file control block 
$defpic define picture node offsets 
$sfdef :define stack offsets 
; local data 
rtshare ;sharable 
0000 95 
0000 96 bformattab: stable of chars for B-radix conversion 
31 30 0000 97 ebyte “a\O\,*a\1\ sentries for B 
33 31 32 30 0002 98 sbyte “a\O\,“a\2\,*a\1\,“a\3\ sentries for B2 
36 32 34 30 0006 99 ebyte “a\O\,“*a\4\,“a\2\,*a\6\ sentries for B35 
37 33 35 31 QO0A 100 ebyte “a\i\,*a\5\,*a\3\,*%a\7\ ; : 
43 $¢ 38 33 8005 101 ebyte “a\O\,*a\8\,“a\4\,*a\C\ sentries for B4 
45 36 41 01 1 byte “a\2\,*a\A\,“*a\6\,“a\E\ ; 
44 35 39 Ht 0016 10 ebyte “a\i\,*a\9\,“a\5\,*a\D\ 
46 37 42 33 OO1A 104 ebyte “a\3\,“a\B\,“a\7\,“a\F\ ; 
OO1E 193 
QO1E 106 ;++ — 
OO1E 107 ; pliS$$getfmt_ré 
QOO1E 108 ; a veer 
QO1E 109 ; functional description: : : ; 
QOIE 110; control formats are processed and the next item is transmitted from the 
Ove FYI 3 file buffer via edit directed input. for data formats, the general 
O1E WN : flow is: the compiled code jsb's to pli$gete**** routine. that. 
Ole 863 3 routine saves the source address and precision and jsb's to this | 
O1E 114 ; routine to get the next input item. this routine processes interceding 


— 7 


PLISFORMAT 16-SEP-1984 02:18:05 VAX/VMS Macro v04-00 Page 
5 O06 ay 99:39:03 PLIRTL.SRCJPLIFORMAT.MAR; 1 . 
control formats until a data format is encountered. the data format 


evaluates its parameters and gets the proper number of characters by 
qs) ing to plid$getnedi. pli$$getnedi returns a character string 

n the field area of the current format. the data format routine then 
converts this character string to the a temporary, whose data type is 
based on the format. it returns with the address, pres tstes and data 
type of this temporary. the ht tee routine then restores the 
target information and calls pliScvrt_cg_r3 to finish processing. 

note that the common control formats for input and output are located 
in this section. all output control formats MUST PRESERVE RS, which is 
used to store the offset of unaligned bit sources. 


inputs: 
r11 = address of stream block 
ap - address of fcb 
outputs: 

r0 - address of field in stream block 

ri - precision / scale of temp in stream block 

f r4 = case index of temp as the source to any 

side effects: 

r0-r6 are destroyed 


Li$$getfmt_ré:: 
50 04 BB 90 . s movb 


astr_l_fp(r11),r0 sget format type 
04 AB D6 e < ¥ 


incl = str_U_Fp(r11). supdate format pointer 
case type=b,r0,limit=41,< - ;case on format type 


AM AAA AAA AAI UIT UII UII UI IU IIA ROP een en crm min rm mmr nemmmmmermmmmmen 
ee ee ee eee ee ee eee ee ee ee eee SS 
SNAAAAAA AAA OO UUIMUIUVIUIUMIUIUIVIES BEE EEE BB WWWNWWIIononoronononononunn 2 
=—DOOO NONE WAR 0 OO NAME WN) 0 OONOAUE WAR O OONOAU FWP" OWOONOU EWR —-OOOnNOu 


getbiter, 31 byte constant iteration 
getwiter, - :2 word constant iteration 

get) iter. . :3 long constant iteration. 

nvfrm, = 74 pc relative iter (invalid). 
getexpriter, - 35 expression iteration (Version 1) 
geteof, - 76 end of format : : 
getexpriter_ve, - 3:7 expression iteration (Version 2) 
invfrm, = 38 invalid format 

invfrm, - 79 invalid format 
geta, - 310 alphanumeric format 
getbi, - 311 bit (1) format 

getbi, - 16 bit 1 format 
getbe, ° 313 bit § format 
getb5, - 314 bit 3 format 

getb4, - 315 bit 4 format 
getcol, - 316 column format 
getcol, - 317 column format 
gete, - 218 exp format 

etf, - 319 fixed format : 

nvfrm, - :20 Line format invalid for get 
getp. - :21 picture format 

nvfrm, - $6 page format invalid for get 
getr, - 325 remote format (PL/I version 1) 
getskip, - 3724 skip format 

nvfrm, - :25 tab format invalid for get 
gets. - 326 blank format 

nvfrm, - i2? left paren (no longer used) 
getrparen, - 328 right paren P 
getr_v2> :29 remote format (PL/I version 2) 


0136 


B5 


0000053Cc° 
51 04 


04 


Al 


0000053c' 
51 04 


04 AB 


8C 


0000053c' 
51 04 


04 AB 


FF76 


0000053c* 


51 08 


AF 
06 


EF 
BB 
AB 
5E 
AF 
06 
EF 
BB 
02 
49 
AF 
06 
EF 
BB 
04 
34 


CF 
06 


EF 


WOVIPIM SPOAMOM YO 
PIPIPIPINPIPYINININIPOPODINIPIPIPYNINPINPININININPININININININ 2 Ps PO ss Os Os Os es ss se es ss ss es es es es 
POPOPOPMNINININDS 39 9 9 OP MP DOQOOOODOOOO DW: 30000 O OOO 00000000 0900909090900 SII NNNINS 


So 
SOooooooooooooS 
SSSSssS8S8 S @ & 


Sooooocooooo 


brw 


, 4 


16-SEP=1984 02:18:05 VAX/VMS M 04-00 p 
aes 05:39:05 Hat age 


invfrm 


PLIRTL.SRCJPLIFORMAT.MAR; 1 
z;none of the above, invalid format 


process an iteration factor. the iteration factor is stored on the format 


stack as a count and the address of 


its first item. if the iteration factor 


: is less than or equal to 0, we will skip the format item(s) between the 
; iteration and its matching right paren. 


getbiter: 
ushab 
rb 
putbiter: 
pushab 
biter: cvtbl 
inc 
brb 
getwiter: 
ushab 
; rb 
putwiter: 
pushab 
witer: cvtwl 
addl 
brb 
getliter: 
ushab 
putliter 
pushab 
liter: movl 
add 
brb 
getexpriter_v2: 
ushab 
orb 
putexpriter_v2: 
; gushieb 
exiter_ve: 
movl 
brb 
getexpriter: 
ush 
orb 
putexpriter: 
pushab 
exiter: movl 
exiter_common: 
mov 
addl 
addl 
calls 
mov l 


getitercom: 


pi centres fe 
iter 


pli$$getfmt_ré 
witer 


tr_l_fp(rT1) 1 
ister. fp(rii) 
getitercom 


hy utfmt_ré 
s 
#2 


Pi coontins, 78 
iter 


Li$Sputfmt_ré 

str_l_fp(rT1),r1 
#4,str_l_fp(r11) 
getitercom 


pli$$getfmt_ré6 
exiter_v 
pli$$putfmt_ré 
str_l_parent(r11),r1 
exiter_common 
pli$$getfmt_ré6 
exiter 

Li$$put fmt_ré6 
ates aes 


astr_l_fp(r11),r0 
#4,str-l_fp(rif) 
str_l_fotri1),r0 
#0,Tr0) 

r0,r1 


sbyte constant iteration 
;set return addr 
scont in common 


zset return addr 

sget iteration count 
supdate format pointer 
scont #m common 


sword constant iteration 
sset return addr 
scont in common 


;set return addr 

sget iteration count 
supdate format pointer 
;cont in common 


;long constant iteration 
sset return addr 
scont in common 


:set return addr 

:get iteration count 
;update format pointer 
scont in common 


sexpression iteration (Version 2) 
sset return addr 
scont in common 


iset return addr 


sget parent frame pointer 
:Join common code 


sexpression iteration 
:set return addr 
;cont in common 


tset return addr : 
sget parent frame pointer 


zget rel addr 

supdate format pointer 
:get absolute addr 
scall the routine 

iset iteration factor 


sprocess iteration factor 


1 
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O06 b7SEp-1 98 96:43:08 PLIRTL.SRCIPLIFORMAT.MAR; 1 . (1). 1-1 
52. 68 00 00D8 9 mov | str_l_sp(r11),r2 iget format stack pointer 
50 9310 CB OE oop 0 movab <str TStackend+B>(r11).¢ iget last place for an iteration 
z- 30 81 OF 1 cmpl r0,r2 sis there room for another iteration? 
A 1B OQOE § blequ 10 :if lequ, yes continue 
50 seneaet *" BY RE? ? povs Goh [narereetenth. re zset serees stack overflow 
rw a sand fa 
72 04 AB 00 OOEF 5 10$: mov | etr_t_ pcrit) -¢r2) spush fp on stack 
72) 51 00 OOF3 539 mov l ri,-(F spush iter count on stack | 
6B 52 DO OOF6 7 mov | r2,str_l_sp(r11) store stack pointer 
4A 62 F4 OOF9 $36 booger (r2) , 30$ 3;do an iteration 
OOFC 39 ; the format iteration is < 0, so we must skip all format items until the | 
pore $e : matching right paren is found. 
oe 2 OFC 41 c{rl (r2) skip this iteration, clear paren count 
50 04 8B 90 OOF stg 208: movb astr_l_fp(ri1),r0 sget next format | 
04 AB 010 24 incl str_U_fp(r11 sincrement format pointer 
010 244 case bype=b.r0. limi t=A1,< - j;case on format type 
9105 245 703, = 31 byte iter 
0105 246 80$, - i¢ word iter 
0105 247 90$, - 33 long iter 
0105 248 invfrm, - 34 pe rel cons 
0105 249 90$, - 75 expression iter (Version 1) 
0105 250 invfrm, - :6 end of format (not expected) 
0105 251 90$, - 3:7 expression iter (Version 2) 
0105 $26 invfrm, - 78 unused 
0105 25 invfrm, - 79 unused 
0105 254 50$, - 710 a 
0105 255 50$, - 311 b1 
0105 256 50$, - 312 b1 | 
0105 257 50$, - 713 b2 | 
0105 258 50$, - 314 b3 
0105 259 50$, - 715 b4 
0105 260 50$, - 316 col 
0105 261 50$, - 317 col 
0105 $66 40$, - 118 e 
0105 26 40$, - 319 f 
0105 264 50$, - 720 Lin 
0105 265 50$, - :21 pic 
0105 266 208, - 3:22 page . 
0105 267 50$, - 323 rem (PL/I version 1) 
0105 268 50$, - 724 skip 
0105 269 50$, - 325 tab 
0105 270 50$, - 726 x 
0105 271 invirm, - se7 left paren 
bie sf¢ 60$, - 328 right paren | 
105 7 45$> 329 rem (PL/I version 2) 
0143 9274 d 
0056 31 01435 275 brw invfrm sinvalid format ; 
05 0146 76 30$: rsb sprocess next format item 
0356 0 Riek 77 40$: bsbw get_format_parm get first parm 
0353 0 Q14A 78 45$: bsbw get_format_parm get second parm 
0350 Q 0140 79 50$ bsbw get.format pare sget last parm 
AC 11 0150 80 brb 0$ 390 again 
62 O07 0152 81 60$: decl (r2) sdecrement paren count 
A8 . 154 Ht bgeq 20% :if geq, then go again 
6B 08 ¢ 156 8 addl #8,str_l_sp(r11) clean stack F 
05 0159 84 rsb sprocess next format item 
04 AB D6 OSA 85 708: incl str_l_fp(ri1) skip iteration 


io 
1-006 
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0000053C" 
0 960s 


Oma 
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5 


04 AB 0C04 
08 AB Da 
04 AB 00 

68 


RB SVS 


ow 
or 


50 00000000' 8F 
0380 


50 00000000'8F 
0376 
50 00000000°8F 


036C 


02E3 
E7 


50.51 
00000000 ' GF 
54 2D 

01 

OA 

02 

06 

03 

02 

04 

02C3 

C7 
51 
GF 


50 
00000000° 
18 AB 5120 
OA 


WOOO 
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lolol el eel ele lel el ele ele ele elelelelolelelelelelelelelelelelelelelelelelelelelelelelelelelelelelelel ale ole) a! a) 
ee ee a a es a ds 3 8 3 SS SS SS 3 SS SS Ss SS SS SS SS SS SS SS SS SS Ss HS 
MMMMNOOVOCCTCVGVAMOOONOOCOCOCWDWWWWOW YS KS YS PF PF OOO OOOWWWON NI NAAOAAAOOUM 
STOWOOINS FF OM LMVOMOOOCCWONM"S PF NOOGTAOCOWOOCTOW OW & Sry TS LPM mMmmnD OVin"o 
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16-SEP- 
6-SEP- 


100$ 

‘ str_l_fp(ri1) 
#4,str_l_fp(ri1) 
tenho . 

20$ 


984 02:18:05 VAX/v4S Macro V04-00 Pa 
Bee SFi45i 23 PAKTEES Baers vO emar mari 2% 


continue 

iskip iteration 
;continue 

iskip iteration 
zincrement paren count 
390 again 


; end of format - if processing remote format, return to ‘caller’. otherwise 


3 repeat format. 
geteof: peer 
rb 


puteof: pushab 
comeof: movab 


10$: movl 


invfrm: movl 
b 

invfrmprm: 
mov 


: brw 
invstrfmt: 
mov 


ps Seager tat re 
comeo 
pli$Sputfmt_ré6 


str_l_stacktr11),r0 


str_lisp(r11),r 
10 


;set return addr 
sconat in com 
3set return addr 
iget addr of top of stack 
sanything on the stack? 
lssu, yes, its end of remote 


$1 
str_listack(r11),str_l_fp(ri1) ;restart the format 


390 again 
astr_l_sp(ri1),str_l_parent(rl1) ;reset parent pointer 


#4,str7l_sp(r14) 


astr (“sper tt) str_l_fp(r11) sreset format pointer 


#4,stril_sp(rii) 


#pli$_invformat,r0 
fail 


#pli$_invfmtparm,r0 
fail 


#pli$_invstrfmt,r0 
fail 


:clean stack 
:90 again 


sset invalid format 

zand fail 

sset invalid format parameter 
sand fail 


zset Fa stream format 


brw ; sand fai 
; a format, input. get the width, get that number of chars and return. 


eta: bsbw 
. b 


et_format_parm 
ovirnere 
a 


3; b format, input 


3 set the radix factor 
getbi: pushl #1 
rb gst 
getb2: pushl 2 
rb ggtb 
getb3: pushl 3 
rb goth 
getb4: pushl 4 
3 get the width and that number of chara 
getb: bsbw et_format_parm 
eq nvirmprm 
mov l ri 


J jsb- 
; skip leading b 
skpc 


bneq 


x 
20% 


.r0 
“pli$$getnedi_ré 
cvt_k_src_char,r4 


Pi a 
9p $$getnedi_ré 

anks. here must be at 
#*x20,ri,str_b_field(ri1) ;skip leading blanks 


sget the parameter 

zif leq. then invalid format 
sset width 

sget the item 

sset case index 

sreturn 


spush radix 
;continue in common 
spush radix 
scontinue in common 
spush radix 
continue in common 
spush radix 


cters 


sget the parameter | 

:1if leq, then invalid format 
sset width 

-get the item 

least 1 non-blank. 


zif neq, non-blank found 


PLISFORMAT 16-SEP-1984 AX/VMS Macro V04-00 Page 7 
1-006 BrSepa19B4 ViiS0s47 EPRIRT SREIPLYSORMAT MAR:1 22° (4) 
50 rnd, F 0 10$: movl #pli$_cnverr,r0 set conversion error 
en 1 rw fail gand fail 
26 DO 20$: mov | r9,r save length left 
5 51 d0 mov ssave addr of Ist non-blank 
; locate setting blanks. if, won't convert them 
61 50 20 3A 0,r0,¢ sfind next blank 
09 «13 beql 308° :if eql, not found, cont 
56 6 50 ge subl r0,r6 get new Length for string 
61 50 20 | skpc #*x20,r0,(r1) sgnytning left other than blanks? 
E1 1 bneq 10$ if neq, onag n yes: error 
GP” the esr trent hars to the begin ning of the 
18 AB 65 29 28 aeve (r5) sip stictyy Copy to beginning of field 
10 AB dO ovl "3, 6tf. (_f t(r11) e field poin 
? convert the chars to a -{}3- cering based + the radix torter 
50 8ED0 popl r0 srestore radix 
QOOO00000'GF 16 js “pli$$chrbitn re, tconvert to a bit string 
54 00000048 8F 00 mov cvt_k_src_abit,r4 set case index 
05 rsb sreturn 


| 
| 
} 
column format, input 
if the requested column is after current column, and before the end of the 
Line, we just position the buffer pointer to the requested place. 
otherwise, perform a getskip; if the column can now be pesitiened as 
requested, then do so, otherwise give up. 
| 
| 


DOUVIOS OLNMO SP NVWOS WOO OOOO O9 NO} NNW IMO OUIW TT HOON 


NAMES WN OS OO NAME WRI OS OOO NAU SWRI OS ODONAU SW OOO NOUS WN OOONOULW 


; e format, input 
8; ot the parameters. w,d and s are supplied, but s is ignored. | 
9 gete bsbw get_ format parm get width | 

i 


SOOOOCOOSCOCOOCOCOOCOCOCOSOCOCOCOOOS OOO OCOOSOOCCCOCOOSOOCOSOOOOCOOOOOCOCOOOOOOOOo 
RIPIPIPINININIPPININININIMPYNPYPININININININININIPUNINPININPIPININPIPYNINYININPINIPYPIPOPGIPOPIPINPINPINYI NINN 2 
COCD 0909 SII NOD OO TTT & NINN III DININUINPINPINPINININ) 2 | | “DOOCOCOCC NTH HMmM 
AANADNA. AA AAAANANAAANAAANAAAANNNAINANIN ANNAN AANA NANAANAAAIA AANA 


WOOO O OOOO O00 09.09 09 09 09 09 09 09 00 SINNOTT Ee ES 


O03 OC AC 17 €1 getcol: bbc #atr_vistring, fcb_l -attr (ap) (9 sif string i/o. 
FF8O 80— 31 brw invstrf¥mt il tte invalid string format 
026D 30 5$: bsbw 96¢- _format_parm i the parameter 
07 14 bgtr : gtr, cont 
03 13 beql 10$ f eql, use 1 
FF6C 8=— 31 brw invfrmprm ‘its iss, invalid format 
51 06 10$: incl ri suse 1 instead of 0 
52 D4 20$: clrl r2 ssay that this is first time through 
2—E AC 3«651~—oé«BI cmpw ri1,fcb_w_column(ap) already past requested column? 
1D 3619 blss 30 :if lss, then yes 
30.6 S]l0C CU ECACC 258: subw3 fcb_w_column(ap),r1,r0 iget number to move 
2E AC) 3=—551~—s«&BO movw r1,?cB_w_column(ap) supdate column 
i. ae movzwl r0,r0 ~ make it Long 
Ss Wat 3 i addl3 0. fcb_l_buf_pt(ap),r tmake updated buffer pointer 
18 aC) 653—Cié*@ cmpl  3,fcb-l~buf atti ie ipast end of this Line? 
06 «18 bgeq 30 if geq, then yes 
1c AC )}3=6553—siéiO mov | r3,fcb_l_buf_pt (ap) iupdate buffer pointer 
1D 11 F brb 40$ 
52. D5 1 30$: tstl r iis this first cine through? 
19 14 3 bgtr 40$ ange if no, give up trying 
OC AC 02000000 8F CA 5 bicl datr_m_virgin, feb_l_atts (ap) ide lover” nie (so we don't skip 
D first record) 
7 2 oe D mov L ri,r3 ;save requested column 
O00000000'GF 16 0 jsb g*pli$$getskp1_r2 :do a skip 
+) eS ee 6 movl r3.r) restore request 
52 01 00 9 mov l #1,r2 jsay that this is second time through 
C6 «611 C brb 25% 3go try to position on new Line 
FD9D = 31 : 40$: brw pli$$getfmt_ré 790 again 
1 
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bgeq 10$ 
brw invfrmprm 
10$: bneq 208 
brw zero 
20$: mov | ri,r 
bsbw 9gt-format_parn 
bgeq 0$ 
brw invfrmprm 
30$: mov ° 
bsbw get_format_parm 
movl r2,r 
; get the required’ number of chars 
jsb Se paneer _r6 
sbw char_f 
movab oF ak Hataten, r2 
movqg =(§ ati 
calts <P i$fchrfltd_ré 
movqg #0 9° 
movl #cvt << usrc_fltd,r4 
rsb 
-enabl lsb 


f format, input 
get w,d,S. S$ is ignored 
gett: bs 


bw 96t- format_parm 
geq 
brw invfrmprm 
10$: bneq 208 


zero: bsbw get_format oe 


sbw get_format_parm 
movab str_b_ fretaceit), r0 
trl (rOy ~ 


clr 
mov | #31401 - 
mov Seve. k_src_fixb.ré 
rsb 

20$: mov lL ri,r2 
bsbw geg-format_parm 
bgeq 50$ 
brw invfrmprm 


30$: mov 


rir 
bsbw gst. format_parm 


mov l 
3; get the required’ nunber of chars 
sb g*pli$$getnedi_ré 
eovl 20° rg 


occ #*x2e,ri,(r 


mov | #pli$_cnverr,r0 


aoe: 
3; make eure there "1 noghing but trailing. blan 
locc #*x20,r0,(r 
beql 
subl r 2.58 
skpc #*x20,r0,(r1) 
beql 
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eq, 
it 9: €e phon invalid format 
tf neq, then cont 

tmake result zero 
;save width 
th agg digits 

eq, co 

+ fea" te invalid forna 
we frac digits for pliStehrfltd. r6 
iget scale factor 
sset width 


sget the field 

get the float context 

addr field as target 

save destination 

convert fractioned char to float dec 
; use destination of cvt as src 

; set case index for fltd src 

; return 


Sete De Ge Be Ge Se 


:get width 

f geq, cont 

its lss, invalid format 
:if neq, then cont 

;get next parm 

iget last parm 

sset addr of result 
sclear result 

sset precision 

zset case be ol for fixb 
sreturn 

:save width 

wT. ge digits 


tits wth invalid format 
zsave fractional digits 
sget scale factor 

:set width 


sget the field 
iSave start addr 
zsave Length read 


ovl ri, 
. shore’ is no dec inal point in the input, we use the specified d to imply one 


sfind the decimal point 
44 eql, then use fractional digits 
ave peer of point 


Sind. trailing blank 

:if eql, then none 

get new length of field 
sanything Left other id blanks? 
if eql, then no, ok 

3set conversion error 


PLISFORMAT 16=SEP=1984 02:18:05 VAY/VMS Macro V04-00 Pa 
5 O06 green abe Maisoiee POC INTE. eaeSeL concer mars? 2% 


0207 31 1c = 457 _. _otw fail sand fail 
1F 128 ; pli$charfixd_r6 allows an exponent, but f format does not. we will append 
8 1F 459 ; an exponent of 0, which will cause charfixd to signal error if the input 
1F 460 ; already has an exponent. 
29 26 56 c} O31F 461 dos: addl r Bor :get addr of end of field 
5 > a? 3 188 subl r5,r0,r get number of fractional digits 
53? 46 decl r ; 
60 3345 8F BO 9 464 movw #*x3045,(r0) sappend "E0', (its not allowed in f) 
51 Pa. Ci 03 465 addl\3# aK rf zset length for convert 
Ww 3 D1 «(03 466 cmpl rows zbength max fixd prec? 
0 15 033 467 bleq 50$ sif leq, then no, cont 
2¢ 1F be oeei 238 mov #31,r2 juse max prec 
| ie 08 A 469 50$: ashl #8,r3,r3 set scale of temp = # digs in frac 
53 26 88 O33E 470 bisb rgers sput in the prec 
5 DD 0341 471 pushl save prec,scale 
50 18 AB 9E 0343 tre movab Sif gue! Weer tte ore sset addr of src 
50 00 0347 47 mov l te .. : :set addr of dst 
OO0O0OCOO'GF 00 FB Q34A 474 calls #0,g*pli$charfixd_r6 convert to fixd 
51 BEDO 0351 475 popl r . srestore prec,scale 
50 18 AB 9E 0354 476 60$: movab str_b_field(r11),r0 sset addr of temp 
54 1B 00 0358 477 mov | #cvt_Kk_src_fixd,r4 zset case index 
05 0358 478 rsb return 
035C 479 ; there was no decimal point in the input string, so we will convert to a non- 
035C 480 ; scaled fixd, and fix up the scale after the conversion. 
50 18 AB 9E O035C 481 70S: movab str_b_field(ril),r0 sget addr of field 
60 52 20 38 0360 tee skpc #*x207r2,(r0) iskip leading blanks 
61 50 20 3A 0364 48 loce #*x20,r0,(r1) ifind trailing blank 
18 13 0368 484 beql 0$ sif eql, no trail blanks, cont 
51 DD Q36A 485 pushl ri save start of blanks 
52 50 C2 Q36C 486 subl r0,r2 sdon't count blanks in Len 
61 50 20 38 O36F 487 skpc #*x20,r0,(r1) iskip trail blanks. 
OA 13 0373 488 beql 80$ sif eql, ok 
50 00000000' 8F 9 0375 489 movl #pli$_cnverr,r0 sset conversion error (non blank found) 
01A7 1 037C 490 brw fail zand fail 
51 B8EDO O37F 491 80$: popl ri get start of blanks 
61 3045 8F B0 bae8 492 90$: movw #*x3045,(r1) sappend ‘EO’ (its not allowed in f) 
51 52 02 Ci 0387 49 addl3 #2.r ri zset len of src 
1F 52 D1 0388 494 cmpl ro.a34 slength > max fixd prec? 
03 = =15 th33 495 bleq 106$ sif leq, then no, cont 
38 1F DO 0390 496 mov #31,r2 suse max prec = ee 
54 5 08 78 0393 497 1008: ashi #8,r3,°4 zset scale = numb digs in frac 
54 52 88 0397 498 bisb r2,r4 zset Len 
54 DD 039A 499 pushl 4 : ssave prec,scale 
50 18 4g ” tH 209 movab str_b_field(r11),r0 sset addr of src 
. oF D0 03A 01 movl r2,r sset len of dst 
52 50 D0 O3A 206 mov r0,re2 : sset addr of dst 
00000000'GF 00 FB Q3A6 50 calls #0,g*pli$charfixd_r6é zsconvert to fixd 
51 8EDO ti ape popt ri srestore prec,scale 
A2 11 038 05 r 60$ continue 
038 506 -dsabl (sb 
038 a4 ‘ 
038 08 ; picture format, input : 
bee 09 ; get the addr of the picture descriptor 
00F8 30 038 10 getp: bsbw ogt.format_parm iget the parm 
0 12 tr 11 bneq 0$ :1f neq, cont 
FOES 31 B7 18 brw invfrm : ; 
5 DO O3BA 513 10$: movl ri,r6 save picture descr addr 


PLISFORMAT 16-SEP-1984 02:18:05 VAX/VMS Macro v04-00 Page 10 | PL 
1006 a SEp-1 984 29:55:09 EPLIRTL. SRCIPLIFORMAT MAR; 1 , (1) | 1 
BD 14 ; get the required chars 
50 04 Al 9A BD 15 poyzbl picéb byte_size(ri),r0 ;set size fo read 
Q00000000'GF 16 1 18 sb gpl S$getnedi_ré iget the field | 
7 17 ; validate the picture. note that p forma requires that the chars read be 
7 218 ; a valid picture ete ine. this differs from List — of a picture variable 
7 19 ; where the input must be a valid fixed decimal number. 
50 oD 7 520 pushl fr0 set addr 
2) 44 ; ; 1 push ri hee sen th rece ‘a 
us r ise cture desc addr 
00000000 ' GF e3 FB D : Calls i, “pli$valid_pic ewalidate picture 
OA 50 «EB 4 524 blobs r :if lbs, cont 
50 00000000‘ 8F b0 7 2 5 mov l #oli$_cnverr,r0 zset conversion error | 
0145 1 E § brw fa gand fai 
50 18 AB 43 3E1 527 208: movab str_b_field(ri1),r0 sset addr | 
51 56 OD 3E5 55.28 mov l r6,r sset pic desc addr 
54 00 00 O38 262 movl #cvt_k_src_pic,r4 sset src data type 
05 : ° 239 rsb return | 
3EC 236 ; version 2 remote format. a remote format is processed by using the nesting 
3EC 65335; level difference passed as the first format param to calculate the parent | 
3EC ©6534 ; pointer of the remote format. this calculated parent pointer is then set 
3EC ©6535 ; info rl for all vfe calls that occur im the remote format, and the vfes | 
3EC 536; use rl for uplevel references to automatic variables. 
FC2E CF QF OQ3EC 537 Getr ve rpushes pli$$getfmt_ré ;set return addr 
06 11 O3FO 538 rb comr_v zcont in common 
QOOOOSSC'EF 9F 03 § 539 putr_v2:pushab pli$$putfmt_ré ;set return addr ; 
OOAS 30 03 540 comr_v2:bsbw ogy. fernet, pore get nesting level relative to referencer 
03 18 O3FB 541 geq 10$ :if geq. continue 
FO9C §=31 O3FD 276 rw invfrm selse invalid format 
53 AB DO 0400 543 10$: movl str_l_parent(r11),r3 eget parent pointer of referencer 
51 D7 0404 544 208: decl ri :decrement relative nesting level 
16 19 0406 545 blss remcom sif lss then have correct parent pointer 
53 OC Ad DO 0408 546 mov l sf$l_save_fp(r3),r3 selse get next higher parent pointer 
F6 8611 O040C 547 brb 20$ sand go back 
ite tt | 
40E 550 ; remote format. a remote format is processed by pushing the address of the 
E 551 ; next item in the original format onto the format stack. when the remote 
E 226 : formats end of format is encountered, this address is popped, and control 
E 553 ; returns to the original format. 
FCOC CF «OF —E 554 getr: pupae pli$Sgetfmt_ré set return addr 
06 i1 2 555 rb comr scont in common 
OOOOOS3C°EF OF 4 556 putr: pushab pliS$$putfmt_ré sset return addr | 
53 08 AB 0 A rH comr: movl str_l_parent(r11),r3 pickup default parent 
007F 0 ; 58 remcom: bsbw get..format_pare zget the remote format 
03 «12 559 bneq 0$ :if neg, continue 
FD76 3 3 ©6560 brw invfrm sinvalid format 
50 0410 CB E 6 561 10$: movab <str_l_stack_end+8>(r11),r0 iget addr of last place for remote 
25 6B 00 B 286 mov str_U_Sp(ri1J.r get format stack pointer 
5 50. . cmpl r0,r2 sroom for this remote? 
OA 18 1 564 blequ 206 :if lequ, then yes 
50 00000000'8F 9 3060s 45565 mov l #pli$_formatovfl,r0 sset format stack overflow 
00 1 & 208 brw fail sand fa 
es 04 AB DO D 67 208: movl str_l_fp(r11) ,-(r2) spush addr of next item in this format 
7 08 dO 1 of mov l str_l_parent(ri1),-(r2) ;push parent pointer for this format 
6B 5 DO 5 3 mov l r2,str_t_sp(r11) istore stack pointer 
04 AB 51 ~=«200 8 570 mov l ri,str_l_fp(r11) :set format pointer to remote format 
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PLISFORMAT 16-SEP-19 :18:0 AX/VMS Macro V04-00 Page 
ie BrSEpa19B6 1:84? EPRINTS eREIPLIFORMAT.maR;1 29 
08 AB O53)—COi«*OD 44 71 mov l r3,str_l_parent(r11) ;set parent pointer to remote format 
Be 430 I rsb 3go with remote format 
451 74 ; skip format, input 
03 0C AC 17 1 0451 75 getskip:bbc #atr_v string, fcb_l_attr(ap) s if string i/o 
FD57 1 0456 76 brw invstrfmt i fai h invali string format 
oof HY beee eof 5$: — act format_parm_1 eget t sy ~ al of records to skip 
e 
Foes 31 0Q45E Th Bree invfrmprm sltstee,” snvol es. format 
52. 51 00 red 80 10$: movl ri, r2 iset number to skip 
eeaeees ™ - 16 0464 581 sb 9*pLiss etskip_r2 skip em 
31 te 286 rw 8 URS$ge fmt_r6~ 390 again 
46D 
Beeb 584 ; x format, input 
0028 70 46D 585 jetx: bsbw 165° format_parm_1 et the number . chars to skip 
09 «#413 «047 586 beql iif eql, ignore 
50 51 D0 047 587 mov | ri, tset width 
00000000'GF 16 047 588 sb g “Bliss etnedi_ré sget that number of chars 
FBAO 31 beee 434 10$: rw pli$$getfmt_r6” 390 again 
O47E 591 : right paren - end of iteration. the iteration count on the format stack is 
047E 236 : decremented. if it is <= 0, we go on to the next format item. otherwise, we 
047E 593 ; repeat the leovesed items. 
047E 594 getrparen: 
FB9C CF QF Q47E 595 pus hab pli$$getfmt_ré :set return addr 
06 11 0482 596 comrparen :cont in common 
0484 597 putrparen: , 
OOOOOSSC*EF 9F 0484 598 pushab pli$$putfmt_ré :set return addr 
048A 599 comrparen: 
52. 6B 00 048A 600 mov str_l_sp(ri1),r2 et format sp 
05 62 +F4 048D 601 sobgeq (r2),T0 o an iteration 
68 08 A2 9E 0490 60 movab 8(r25,str_l_sp(r11) ap en stack 
05 0494 60 rsb process next format item 
04 AB 04 A2 DO 0495 604 108: mov l 4(r2),str_l_fp(r11) irestart this format 
05 Been oR? rsb process next format item 
0498 607 ;get_format para? - get a format parm. if the parm is missing, 1 is supplied 
0498 608 ; as defau 
0498 609 ; inputs: 
0498 610 : r11 - address of stress block 
0498 611; ap - address of 
0498 ol¢ 3 3 outputs: 
Ree ei? : ri = value of parameter or 1 if item missing 
re 615 get_ torent t_para_t: 1: 
51 01 DO 0498 olg ri :set missing parm value 
02. «11 ve a4 brb aly format_com :cont in common 
04A0 619 ;get_format_parm - get a format parm. if the parm is missing, 0 is supplied 
4A0 620; as default. 
4A0 621; inputs: 
04A0 6 § 3 rii- address of stream block 
4A 623 ;: ap - address of fcb 
4A 624 ; outputs: 
rs 3 5; ri - value of parameter or 0 if item missing 
04A0 6 5 get_format_parm: 


el 
ae 


N 1 | 
PLISFORMAT 16-SEP-1984 02:18:05 VAX/VMS Macro v04-00 Page 12 
eet ae ee 747 CPLIRTL.SRCIPLIFORMAT.MAR; 1 . (1) 
51 D4 Q4A 6 8 clrl ri set missing parm value 
4A 9 get_format_com: 
OC AB 01) «CA «(04A2 630 #str_m_missing,str_l_fs(r11) ;clear missing parameter | 
4A6 631 ; get the parameter type and case on it 
50 04 8B 90 Q4A6 6 ¢ movb astr_l_fp(ri1),r0 iget parm type 
04 AB D6 Q4AA 6 incl str_U_fp(r11) sincrement format pointer 
O4AD 634 case type=b.r0.< - ;case on parameter type 
4AD 635 103, = zmissing 
4AD 636 $oe" - zbyte constant 
04AD 637 0$, - sword constant 
QO4AD 638 40$, - ;long constant 
Q4AD 639 50$, - ipc relative long constant 
O4AD 640 60$, - spc relative long entry point (V1) 
O4AD 641 5$, - sinvalid format 
Q4AD oh¢ 70$> spc relative long entry point (V2) 
FCD8 31 O4C1 643 5$: brw invfrm snone of the above, invalid format 
0404 644 ; aissing 
OC AB 01 «CB CO4C4 645 108: isl #str_m_missing,str_l_fs(r11) ;set missing parameter 
51 05 Q4C8 646 tstl ri sset default value condition code 
05 O4CA 647 rsb return 
04CB 648 ; byte constant 
51 04 8B 98 O4CB 649 20$: cvtbl astr_l_fp(ri1),r1 iget the parn 
04 AB D6 O4CF 650 incl str_U_fp(r11) zincrement format pointer 
51 05 O4d2 651 tstl ri set cond codes 
05 04D4 63¢ rsb sreturn C 
0405 6535 ; word constant 
51 04 8B 32 0405 654 0S: cvtwl a@str_l_fp(r11),ri sget the parm ; EX) 
04 AB O02 CO 0409 655 addl #2,str_l_fp(rif) increment format pointer EX! 
51 D5 O4DD 656 tstl ri set cond codes FA] 
05 O4DF 657 rs return FCE 
04EO 658 ; Long constant FCE 
51 04 8B DO 0460 659 dos: mov l astr_l_fp(r11),r1 sget the parm FCE 
04 AB 404 «(CO 0464 660 addt = #4, str=l_fp(rif) sincrement format pointer FCE 
51 DS Q46E8 661 tstl ri set cond codes FCE 
05 QO4EA 66 rsb sreturn FCE 
O4EB 663 ; + relative long constant, used for remote and picture formats FCE 
1 04868 DO O04EB 664 503: mov astr_l_fp(ril),ri iget the parm FCE 
04 AB «04 )«=©6CO «(O4EF )6=s 665 a #4,str_l tpcrit sincrement format pointer FCE 
51 04 AB CO O4F3 666 addl str_l_fptril).ri zmake addr absolute FCE 
05 O4F7 667 rsb zreturn FCE 
O4F8 668 ; version 1 pc relative entry point, used for expressions in format items FCI 
50 04 8B DO O4F8 669 60S: mov l astr_l_fp(ril),r0 get the addr FCt 
04 AB 204 )« «60 «OO4FC OO 670 addl #4,str_l tpcrit supdate format pointer FCI 
50 04 AB CO 8200 671 addl str_l_fptri1),r0 zymake addr absolute FCI 
51 FC AD 00 0504 ore mov l -4(fpy,ri sset parent frame pointer FCI 
60 99 FB 0508 67 calls #0, (r05 icall it FCI 
» 3 DO 050B 674 movl r0,r1 set parm FCI 
05 Beoe of? rsb return 4s 
050 144 goyorsion 2 pc relative entry point, used for expressions in format items Ay 
50 04 8B 00 O50F $75 mov astr_l_fp(ri11),r0 get the addr | FCI 
04 aB 04 = «C0 313 680 addt = #4, str“l_fp(rif) tupdate format pointer FC 
50 Of AB C8 51 681 addl str_l_fptrl1),r0 zmake addr absolute | | FCI 
51 8 AB D 51B 6 § mov l str_l perenssett) 6 :set parent frame pointer FCI 
60 98 FB SIF 66 calls #0,Tr0 scall it FCI 
51 DO 0522 684 mov r0,r1 set parm | FCI 
| 
| 
| 
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rsb 
fail: movl 
pushl 
pushl 
pushl 
calls 
ret 


p++ 
; pliS$putfmt_ré6 


functional description: 
control 


flow is: the aes 
routine pushes the 
for the 

for unal 
BE PRESERVED by all 


convert the source 


section. 


ap - address of fc 
outputs: 
side effects: 

r0-r6 are destroyed 


Sete Ge Ge Ge Fe Se Se Ge Ge Ge Ge Se Se Se Se Se Se Se Se Se Sete Se Se Ge Ses 


pli$$putfmt_ré:: 
movb 


placed in the files buffer by jump 
note that some of the common control formats are above in the getformat 


Hf ro 


$72} 


sreturn 


AX/VMS Ma 
PLIRTL.SR 


-00 
ORMAT.MAR; 1 


sset error in fcb 
sset fcb addr 

sset error code — 
sseut error condition 
ssignal error 
sreturn 


3 formats are processed and the next item is transmitted to the 
file buffer via eer are output. for data formats, the general 

ed code 
address, scale and precision and the case index 
eneral conversion routine for the data type of the source. 
ned bit targets, the offset is passed 


jsb's to pli$pute**** routine. that 


in cS. thus r5 MUST 
output control formats or the offset is lost. 


the pli$putet*** routine then jmp's to this routine. this routine 
finds the next data format (processing all ne aly ge control formats) 
and then enters the data format processing code. the da 


ta formats 
ype based on the format. this is then 
ng to pli$$putnedi_ré. 


to a standard t 


- data type as a case index for pli$cvrt_cg_r3 as source 
- address of next item to put 

- prec/scale of 
) - return address 
address of stream block 


item 


astr_l_fp(ri1),r0 iget format type 
incl str_U Fp(ri1). supdate format pointer 
case type=b,r0,limit=41,< - ;scase on format type 


putbiter, - 
putwiter, - 
putliter, - 
invfrm, - 
putexpriter 
puteof, - 
putexpriter 
in - 


v2. ° 


ee 


expression iteration (Version 2) 
invalid format 

hanumeric format 
+1 f 


¢ format 
format 


n 
a 
bi 
b 
b 
b 


ee re ad 


2 2222 


PLISFORMAT 16-SEP-1984 02:18:05 VAX/VMS Macro v04-00 Page 14. 
1-006 bree 1 obec 96:49:05 UPL IRTL.SREIPLIFORMAT .MAR: 1 . (1) 
o3e rg putb4, - 315 bit 4 format 
54 74 putcol, - 218 column format 
B20 744 putcol, - 317 column format 
54 745 pute, - 318 exp format 
054 reg putf, - 319 fixed format 
B24 74 putline, - 9 Line format 
54 748 putp, - 321 picture format 
054 749 putpage, - $6 page format 
054 750 putr, - 7235 remote format (PL/I version 1) 
0543 751 putskip, - 724 skip format 
054 £36 puttab, - 3:25 tab format 
Th 75 putx, - ; § blank format 
54 754 invfrm, - : left paren (no longer used) 
0543 755 putrparen, - 728 right paren 
Bee? £38 putr_v2> 729 remote format (PL/I version 2) 
FC18 = 31 bee, £38 brw invfrm inone of the above, invalid format 
0584 760 ; a format, output 
0584 761 ; get the width 
FFI9 30 0584 762 puta: obsbw get. formset pers iget the parameter 
1F OC AB OO €1 0587 763 ¢ str_v_missing,str_l_fs(r11),20$ ;if parm missing thenl 
O58C 764 ; if the width is miSsing, we convert the source to a char(1000) var. 
53 O00003E8 8F DO O58C 765 mov 3 sset max size for vcha in field 
52 18 AB 9E 0593 766 movab str_b field(ri1),r2 set addr 
54 8E 06 Ci 0597 767 addl3  #cvt_K_dst_vcha,(sp)+,r4 ;set case index for vcha dest 
50 8—€ 7D 0598 768 108: movq (sp)?,r zset src addr, and prec 
00000000'GF 00 FB Q59E 769 calls #0,g*pli$cvrt_cg_r3 sconvert src to vcha 
OSA5 770 ; put it out 4 
00000000'GF 17 QSA5 771 : jmp g*pli$$putnedi_ré sput it in buffer and return] 
05AB ure swidth present 
51 D5 O5AB 773 208: tstl ri selse Cset cond codes 
29. 13 O5SAD 774 beql 50$ sif eql, ignore this field 
3 14 QSAF 775 bgtr 30$ sif gtr, cont | 
FBF2 «8931 0581 776 brw invfrmprm sits lss, invalid format 
QOOOO3E8 8F 51 4D 05B4 777 30S: cmpl r1,#1000 zlen too big for field? 
A 15 0588 778 bleq 4 ; eg, no | 
50 00000000'8F 00 O5BD 779 mov l #pli$_strovfl,r0 sset field overflow 
FFSF = =631 O5C4 780 brw ai zand fai 
AB 51 BO Q5C7 781 40$: movw ri,str_b_field(r11) sset len in field 
53. 51 00 O5CB res mov | a ee sset dst len 
52 1A AB 9E OSCE 78 movab <str_b_field+2>(r11),r2 ;set dst addr 
54 8E 05 Ci QO5dD2 784 addl3  #cvt_k_dst_char,(sp)+,r4 ;set_case index for char dest 
cs v7 pepe 785 brb 10$ icont 
5E OC AE 9E 05D 786 50$: movab 12(sp),sp iclean stack . : 
05 05pC At rsb sits a(0), ignore field by returning 
O5DD 486788 | 
0500 789 ; b format, output | 
5DD 790 ; set the radix : 
01 ODD OQO5D0D 791 putbi: pushl = #1 set radix 
OA 11 OQ5DF 038 rb pytb scont in common 
02 OD bee 793 putb2: pushl 2 sset radix 
66 11 Q5E3 794 rb pytb scont in common 
0 DD 2E3 795 putb3: pushl set radix 
02 11 O5E 796 rb utb scont in common 
04 DD O5E9 797 putb4: pushl 4 = sset radix 
OSEB 798 stack at this point: 


dD 2 
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et the width 

f gtr, cont 

f gal: check for missing 
ts lss, invalid format 
1),20$ ; 


; 

| 

ri ;if parm missing, use src prec 
sits a(0), so clean stac 

treturn 

src 

;Save current stack addr 

;save width 

iget data type of rarer 

case on src data — 

30 pic, not yet implemented 

31 fixb 

fltb 


sinvali¢ dats type, fail 

iset dst phe: eql to src prec 

abe 9 gfloat indicator 
icon 
zget * bie of pic descr 
iget src prec 
:get src scale 
cont 
get src peer : 
sclear gfloat indicator 
get src scale 

cgetn number of digs in integer part 

Leg. then result is zero 

get binary precision ecceret? 
:Pound for_ceil and fixed d 


Be. rule 


ifinish (r3=ceil ((p-q)*3. 33) really!) 
iprec > 31? 

:if leq, no, continue 

juse max fixb prec 


iget * ader of field 
ut in width 
lank it out 
celeen stack 
sreturn 
et cur len of vcha src 


sget radix 
; found prec up to next multiple of radix 


PLISFORMAT 16-SEP=1 
be ty 6-SEP-1 gi 9 
SEB 799 312(sp) prec/scale of src 
bee 00 ; §(38} Bddr of src 
bees 01 : 4(sp) datatype of src 
5EB 8s >; O(sp) radix 
FEB2 30 B2e8 03 putb: bsbw get. fornet _parm 
OF 14 FF 04 bgtr $ 
03 13 O5SF 05 beql 10$ 
FBB1 = s«3}1 are 806 brw invfrmprm 
05 0C AB 00 86E€0 « «(O5F 807 10$: bbs #str =¥ _missing,str_l_fs( 
5E 10 AE RE OSFA 808 movab 16(sp)7sp 
05 OSFE 809 rsb Ae: 
peek 810 ; determine the binary precision of the 
18 AB SE DO OSFF 811 50S: movl s str _field(r11) 
56 51 DO 0603 g1¢ mov 
50 04 AE O09 C7? 0606 81 divl3 49. 4 isp) r0 
060B 814 case type=b =b,r0,< - 
060B 815 ; 
060B 816 0$; - 
060B 817 30$, - 
0608 818 40$, - 
060B 819 40$, - 
060B 820 30$, - 
060B 821 60$, - 
060B 822 30$, - 
060B 823 30$> 
FB78 31 0621 824 brw invfrm 
53. OC AE 00 0624 Hy 30$: mov 12(sp),r3 
53 00000080 8F CA 0628 826 bicl #*x80,r3 
58 11 poet 827 brb 70$ 
51 OC AE DO 0631 828 35$: mov l 12(sp),r1 
53 61 9A 0635 829 movzbl pic$w_ pa(r1),r3 
51 01 Al 9A 0638 830 movzbl picSw= “pati(ri) rt 
11 11 063C 831 brb 5$ 
53 OC AE 9A 063 HG 40$: movzbl Ye (gp) of rs 
53 onocosy 8F CA 064 83 bicl #*x8 
51 OC F8 8F 78 0649 834 ashl o-betb tap), ri 
ie 51 ¢2 064F 835 45$: subl ri,r3 
1F 15 0652 836 bleq 50 
53 0000014C 8F C& 0654 837 mull2 #332,r3 
53 00000063 8F CO 3628 838 addl #9973 
53 00000064 8F C6 0662 839 divi2 #106,r3 
1F 53 D1 0669 840 cmpl sr 3, #31 
1B 4615 066C 841 bleq 70$ 
1F 8 =6D0 pegs X: mov | #31,°3 
.—- 3% 671 4 brb 70$ 
AB 9E 0673 44 50$: movab str b ifekatett? ri 
56 ~=B0 beat 845 movw ré6, 
00 2C O67A 846 movc5 #9 i wr x20,r6,(r1) 
AE SE 0680 847 movab  16(sp 
9? pose 48 rsb 
BE C 0685 49 60$: movzwl @8(sp),r3 79 
689 50 58gt size be bit comp fey based on src prec and radix 
DO 0689 851 70$: movi (sp), r0 
C 68C 26 addl r brs 
D 68F 5 decl r 
50 C6 B08 See divl ror 
50 C& 0694 55 mull r0,r 


“oe 


PLISFORMAT be tie Bd 02:18:05 VAX/VMS Bac ro v04=00 Page 
1-006 6-SEP-1984 11:37:47 CPLIRTL.SRCJPLIFORMAT.MAR; 1 
50 53 9Q7 1 0697 56 addl3 a7, *3,r0 jround prec up to a byt 
50 50 FD 8F 7 698 857 asht  a-$,70,r0 iget muaper of bytes required 
oo) 4 6A 58 eql f eql, then result is 0 
6A 59 ;allocate temp - stack and clear Last byt te 
5E 50 C2 OQ6A 60 get space for temp on stack 
FF AEGO 94 Q6A 861 clrb “tsp CrOj Clear last git of temp 
52 5E& 00 Q6A9 Ha movl set addr of t 
28 18 AB b° 6AC 86 mov l ate -: field(r11),r4 iget old stack “pointer 
QO 08 A4 D 0680 864 movg 8(rS)7r0 get original src 
08 AS «653)0=«=6—(D0 S=C(06B4~—s 865 mov rd. 8(r4) Save numter of ots in temp 
OC AS «656 «6200 «6(06B8 566 mov r6,12(r4) ssave width of field 
05 is pene 6 bneq 80 iif neq, cont 
Oc as 55 64 C€ a) 868 divl® (r4),73,12(r4) use converted prec for missing width 
54 04 AG 08 C1 O6C 869 80S: ere agvt k_dst_abit, ote r4';set case index for abit dst 
QO0000000'GF 00 FB O06C8 870 alls 0.9 spl iscurtc og.r3 sconvert src to abit temp 
O6CF 871 ;convert “abit Bs o vcha in field using B-radix conversion 
O6CF Br¢ local r fog jeter usage for conversion: 
O6CF 873; r0 - 
O6CF 874; rl - address of table for this radix 
O6CF 875 ; r2 - current position in bit string 
O6CF 876 ; r3 = output pointer 
Q6ce 877 ; r4 = current bits or char 
CoCF 878 ; r5 = number of chars left to do 
O6CF 879 ; r6 = requested width, number of blanks to append 
54 18 AB DO O6CF 880 mov str ye field(ri1), r4 zsget old stack pointer 
50 64 00 Q6D5 881 mov (r4y sget radix 
51 08 AS DO 06D6 882 movl Birds, rh, iget number of bits in temp 
56 OC AS DO O6DA 885 mov 12¢r45,r sget req width 
QO0003E8 BF 56 D1 O6DE 884 cmpl = r6 11060" iwidth too sis? 
OA 15 O6€5 885 bleq  90$ leg. 
50 00000000'8F DO O6E7 886 movl #pli$_strovfl,r0 ‘set f aby over flow 
FE35 31 OQ6EE 887 brw fail sand fail 
53 18 AB QE O6F1 888 90S: movab str_b_field(r11),r3 iget addr of start of output field 
83 56 BO O6F5S 889 movw r6,tr3)+ :set Length in field 
55. 51 50 C? O6F8 890 diviS r0,r1,r5 get number of bytes of output 
OC AB O08 «CA «(O6FCOC891 bicl iste m_blankend,str_l_ tsiei1 ;assume we can fill req. width 
56 55 01 0700 89 cmpl /5ré ;enough to fill requested width? 
07 19 0703 89 blss 106% rif lss, no 
0705 894 tif gtr and stringsize supported 
0705 895 ithen raise it here 
55 56 DO 0705 896 mov l r6,r5 rset req width as length 
56 04 0708 897 clrl r6 pees no blanks on end 
07 11 O70A 898 brb 110$ 
OC AB 98 cg 070C 899 100$: bisl #str_m_blankend,str_l_ tsirit) sremember to blank out end 
7 5 C2 0710 900 subl r5,r6 ~ iget number of blanks for end 
51 01 50 78 O713 901 110$: ashl r0,#1,r1 et table address 
51 F8E2 CF41 9E 0717 902 movab bformattab-2(pc)CriJ.r1 : ased on radix 
52. D4 O71D 903 clrl r2 istart at beginning of bit string 
54 DD O71F 904 ushl :save a stack pointer 
98 11 1h4 905 rb 130$ zenter | oP, 
54 04 AE 50 2 EF 0723 906 120$: extzv r2,r0,4(sp),r4 sget some bits 
6144 90 0729 907 movb (rf) Cr4), (r$)+ :Store at char in field 
50 CO Q72D 908 addl rQer supdate pos in bit string 
FO 55 = F4& SCOQ7 909 130$: sobgeq r5,120$ 390 again 
a 910 ; append blanks if necessar 
06 OC AB 3 4 07 911 bbc #str_v_blankend,str_l_fs(r11),140$ ;if we must append blanks 
63 56 20 6€ 00 2 0738 912 moves #0,(Sp),a#* x20 oneg® (r3)7 ;append blanks 
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1-006 o-$fp= 1984 39:03 UPLIRTL. SRCIPLIFORMAT .MAR; 1 . (1) | I= 
en 913 1408: addl3 #16,(sp)+,s clean stack 
60000000'GF 17 ard 914 jap "pl iSSputnedi _ré Sput it out 
074 916 ; column format, output 
074 917 ; if the requested column is peng than current column and less than the 
074 918 ; Linesize, we put in enough blanks to position to the requested column. 
074 919 ; if the requested column is greater than Linesize we do a skip. if the 
074 920 ; requested column is less than current column, we do a skip and then 
074 921 ; fill with blanks to get to the requested column ‘ 
03 OC AC 17 + 074 9 § putcol: bbc #atr_vostring, fcb_l_attr(ap) .5$ ;if string i/o . 
FA60 1 Q?740 9 brw invstrfmt sfail with invali string format 
FD4D = 330 $739 924 5$: bsbw ggt_format_parn sget the parameter 
07 14 O75 925 bgtr 0$ :if gtr. cont 
03 13 0755 926 beql 10$ sif eql, cont : 
FASC 31 0757 927 brw invfrmprm sparm < 0, invalid format 
51 D6 Q75A 358 10$: incl r : suse 1 instead of 0 
50 2A AC 3C O75C 929 208: movzwl fcb_wilinesize(ap),r0 ;get linesize | 
50 51 61 0760 930 cmpw r1,r0 zreq col > Linesize 
03 15 0763 931 bleq $ :if leq, no, cont 
i OS. res. See movi #1,r1 suse 1 for col 
51 D7 0768 933 30$: decl r iget req col - 1 
2—E AC 3651 = BI COO76A 934 cmpw ri,fcb_w_column(ap) :Crequested col-1) > current col? 
12 14 O76E 935 botr 508 :if gtr, then yes 
0D 13 0770 936 beql 40$ sif eql, then already at right col 
51 DD 0772 937 pushl ri. save +e col 
00000000'GF 16 0774 938 jsb g*pli$$putskp1_r2 i:do a skip 
51 8EDO Bren 939 port ri srestore req col | 
07 14 Q77D 940 gtr 60$ :if eql, just return 
FDBA 31 O77F 941 40$: brw pli$$put fmt_ré6 390 again 
51 2E— AC A2 0782 206 50$: subw fcb_w_column(ap),r1 sget number of blanks to move : | 
O32E 31 Bree vt 60$: brw blank_field still with blanks, put in buf, go again 
0789 945 ; e format, output | 
0789 946 ;get prec of float dec temp from src dtp and prec 
OC AB 70 «6(CA «(07890 =— 947 pute: i bicl #str_m_gfloat,str_l_fs(rl1) ;assume not g float src 
50 6€ C7 O78D 948 divl3 #9,(sp),r0 get data type of source 
0791 949 case types r0,< - scase on data type 
0791 950 53, = 20 pic 
0791 951 108, - 1 fixb 
0791 952 10$, - :2 fltb 
0791 953 30$, - 33 fixd 
0791 954 30$, - 34 fltd 
0791 955 50$, - 75 char 
0791 956 45$, - 36 vcha 
0791 957 40$, - i7 bit 
0791 958 40$> 78 abit ; 
FOF2 31 O7A7 959 brw invfrm sinvalid data type, fail 
51 08 AE DO O7AA 960 5S: mov Bisp).r' sget addr of pic descr 
53 61 QA O7AE 961 movzbl pictw_pq(r1),r3 sget prec of pic src 
Ze 1 O7Bl 969 brb 335 ont | 
53 08 AE DO 0783 9635 10$: mov L (sp),r3 get prec of binary src 
0453 O07 €5 OQ7B7 964 bbcc #7,r3,20$ :if g float 
0c 10 ¢B 0788 965 bist #str_m_gfloat,str_l_fs(ril) :set gfloat 
53 00000064 8F C4 Q7BF 966 208: mull #100,r sget pli decimal prec 
53 444 Sh gr CO O07C6 967 addl e lof : 
53 000014C 8F (C6 O7CD 968 divl #332,¢r : : 
12 6€ 91 OQ7D4 969 cmpb (sp) ,@cvt_k_src_fltb float bin src? 
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8 is 707 ~=—970 bneq 60$ sif neq, no, cont 
D 709-971 decl r icorrect prec for context computation 
2? = 11+—s«07DB 376 brb ays icont i 
53 08 At 9A O7DD0 97 305: movzbl 8(sp),r3 sget prec of decimal src 
1F 53 9 E5 O7E1 974 35$: bbcc #7,73,60$ -if g float 
OC AB 10 «6B «COO7ES)=—«975 bisl #str_m_gfloat,str_l_fs(ri1) ;set gfloat 
19 11 O7E9 976 brb 60 zcont 
53 1F 00 b7e8 977 40$: mov #31,r3 suse max fixb prec for bit 
a ree 978 brb 20$ scont 
50 04 AE bP O7F 979 45$ mov L 4(sp),r0 3 get addr of string 
51 80 C O7F4 980 movzwl (r0)+,r1 ; and size (point past 1st word) 
08 11 bere 981 brb 558 
51 QO8 AE QA O7F9 ons 50$: movzbl 8(sp),r1 : get size of src 
50 04 AE DO O7FD 98 mov l 4(sp),r0 : get addr of src 
O2DF 30 0801 984 55$: bsbw char_flt_ctx 3; get flt dec context 
53 DD 0804 985 60$: pushl fr3 save dec prec 
0806 986 ; get context of fltb soap 
0B OC AB «4046 = «€E€1 «=2(0806)=—s 987 bbc #str_v_gfloat,str_l_fs(r11),80$ ;if g float src 
01 DD O80B 988 ushl #1 sset for g context 
53 00000080 8F C8 O80D 989 isl #128,r3 set g float bit for convert 
OE 11 0814 990 brb 100$ zcont 
53 OF 01 0816 991 80S: cmpl #15,°3 sis it f or d? 
07 19 0819 blss 90$ :if lss, no 
7E D4 O81B 99 clrl -(sp) zset for d context 
53 OF DO O81D 994 mov | #15,r3 set max prec of d 
02 11 0820 99 brb 100$ :cont 
02 DD 0822 996 90$: pushl #2 set for h context 
12 O08 AE 91 0824 997 100$: cmpb Tole? Sewn R ers. lth sfloat bin src? 
03 12 0828 998 bneq 105 :if neq, no, cont 
04 AE D6 O82A 999 incl 4(sp) scorrect dec prec 
082D 1000 ;allocate fltb temp on stack 
SE 10 C2 O82D 1001 105$: subl #16,sp sget room for temp 
52. 5E 00 0830 1006 mov L spire set temp addr for dst 
50 1C AE 7D 0833 100 movq 28(sp),r0 ;set src addr and prec 
54 18 AE 04 C1 0837 1004 addl\3 #cvt_k_dst_fltd,24(sp),r4 ;set convert index, dst = fltd 
083C 1005 ; convert src to fltd ~ 
00000000'GF 00 FB QO83C 1006 calls #0,g*pli$cvrt_cg_r3 convert to fltd 
0843 1007 ; get w.d,s. s is ignored 
FCSA 30 0843 1008 bsbw get_format_parm sget the width 
QOOOOO3E8 8F 51 D1 0846 1009 cmpl r1,#1000 stoo big? 
A 15 084D 1010 bleq 110$ iif leg. no 
50 00000000'8F 99 O84F 1011 mov #pli$_strovfl,r0 sset field overflow 
FCCD 1 0856 ols brw fail sand fail 
51 b° tH + 9 110$: movl ri,ré save 3S 
FC41 0 5C 1014 bsbw get forast pare get the digs in frac lags 
08 OC a8 0O €0 Q85F 1015 bbs str_v_misSing,str_l_fs(r11),130$ ;if digs in frac not missing 
5 51 DO 0864 1016 mov ri,r3 ssave digs in frac 
19 18 0867 1017 bgeq 1408 if geq, cont 
F9SA «631 0869 1018 brw invfrmprm zset invalid format see 
53 14 AE O01 C3 O86C 1019 130$: subl3 #1,20(sp).r3 suse dec prec of src-1 as digs in frac 
fe 5 oe oes bBo, 1020 addl #7,16(sp),r0 zget number of chars for exp,sign, dot 
50 56 50 C3 0876 1021 subl r0,r6.r sget max number of digs in frac 
50 53 ODI Baca 10 ¢ cmpl r3,r0 :$rc-1 digs too many? 
03 15 O87D 1 bleq 1468 :if leq, no, use src-1 
5350 8 8 7F 1024 mov | r0.r3 ;use number of digs in frac that fits 
FC1B 82 1025 1408: bsbw get_format_parm. sget scale but ignore it 
0885 1026 ; set up parms for Convert routine 
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ee tt ety 5:39:08 CPLIRTL. SR RCJPLIFORMAT.MAR; 1 (1) | 
7E 10 AE O02 C1 08 addl3 #2,16(sp) (sp) zset number of digits ine 
ot DD pushl @# iset number of digits in int 
F D4 clrl -(sp) :set scale factor 
5 DD 8 pushl 3 set number of digits in frac 
2c A 1A AB QE 089 movab <str_b_field+2>(r11) sbaten) sset addr of dest in dscr 
28 AE «56 OCOD 89 mov L r6,40(5 Sy set size of dest in dscr 
8 AB 56 80 8 movw r6,str_ field(r11) sset size in field 
28 AE OF 9 pee SB tsp set addr of dest descr 
14 AE OF - hab p) iset addr of src 
A 3 convert "Tren fled: to ¢ ar 
BA case tyes 8 fotsp). <160$,170$,180$> ;case on src ty 
50 eaoanes 0 - 150$: wey opt i$ _invfmtparm, r0 iset format over flow Treeits size)error 
fw ,an al | 
00000000'GF 06 FB 088 160$: calls * g*FORSCVT_b_TE convert it 
10 11 088 brb 19 ;cont , 
O0000000"GF 06 FB 170$: calls #6 g°ronscyt 6.1 sconvert it 
07 «+11 brb 19 cont 
Q00000000'GF 06 FB 180$: calls 08 -G FORSCVT_H_TE convert it 
DA 50 EY 190$: blbc r0,150$ sif lbc, error 
SE 24 (C0 addl as sp sclean stack 
00000000'GF 17 jmp g*pli $putnedi_ré ;put it out 


: f format, output 
; get w,d,S. S$ is ignored | 


SOOCOCCOCOCOSOOCOCOCOOCOCOOCOOOCOOOOOOCOoOO 
TNS POIMONIMVOVTIIVI NSH FO MOVUIMWWWOS OUIOMOPrPW 


ee a a a ed dd nd ed dd od dd 8 = 8 3 2 8 2 8 3 

SOOCOOCOCOCOCSCOCOCOCSOOCOOCOOOOOSOO COSCO OC COSC OOOOOOOCOOOOOOOOOOOOOOOOoOO 

609090969 SI NIN ISIN NI NINN AAA AAAARAOAMAAAAAAAN AE BBR RR ERB RWWA 

WR SO ODONAUESWN OOO NOUR UIR =O OONAUSWN OS WNOU EWN OODNAUEWN—OOON 
a] 


FBCO § 38630 bsbw aft .fernst pore sget width 
03 14 bgtr 20$ :if gtr, cont 
F8C1 3831 10$: brw invfrmorm sits leq, so invalid format | 
QOOOO03E8 BF 51 O01 20$: cmpl r1,#1000 iwidth tee bist 
OA 15 bleq 308. sif leg, 
50 00000000'8F 00 mov l #pli$_strovfl,r0 iset field “overflow 
FC2E 31 brw fail sand fail 
51 OD 30$: ushl ri save width 
FBA3 30 sbw get.format_parn sget digits in frac 
eS 19 blss 0$ :1f lss, invalid format 
51 DD ushl ri tsave digs in frac | 
FB9C =. 30 504 sbw get_format_parm zget scale, ignored for now 
‘ 
0904 ; we will convert the src to a fixd number with ; 
0904 ; 1 more tractional digit than that required. then we round it to the correct 
Bone ; number of fractional digits. 
50 O08 AE O09 C7 0904 divl3 #9,8(sp),r0 :get data type of source 
0909 case type=b =b,r0,< - :case on data type 
0909 pic 
0909 908. - 21 fixb 
0909 40$, - ig fltb 
0909 70$, - 33 fixd 
0909 70$, - 74 fltd 
0909 90$, - 36 vcha 
0909 90$, - re +i 
0909 90$> 38 ab 
F87A 31 OTF brw invfrm ‘invalid data type 
9 40$: ifltb 
10 AE 0063 8F B1 Q9 cmpw #99,16(sp) idec prec > 30? 
40 14 09 bgtr 90$ tif leq, then no, use common 
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ee tt ay oer} : CPL IRTL. SRCJPLIFORMAT.MAR; 1 . (1). 
92A 1084 ; mov le(sp) r0 iset are oder and prec 
03 A 15 5; nove bee r$ A digs in frac , 
6— 1F D1 OQO92A 10 § cmpl 4 (sp) ry ing . Disses more than 31 digs? 
03 18 092d 10 bgeq ge 9. 9 
F874 «8931 «O92F 1088 50$: brw inv trmprm aif d forest 
36 «611+ «=—0932 1388 60$: brb tgo output rounded format 
44 4 19 0; ashl i, 4 r3 suse digs in yd as scale 
934 1091 ; movb {,r suse max fixd p 
0934 1338 ; subl #16, rs :get space tor. fixd temp 
0934 1093 ; moy | ibs set tmp a 
Bae 1932 ; calls a Dag PLiStLtbtixdré convert fltb to fixd 
: r 3¢o 
51 10 AE 00 $980 1096 65$ mov 1 r] get ‘ddr of picture descr 
51 61 3C 0938 109 movzwl pic$w pa(ri), ri get prec and scale 
51 1F 91 0938 1098 cmpb #3ivr sprec >= 31? 
046 11 O93E 1099 br 75$° zcont 
0940 1100 70$: decimal 
10 AE 1F 91 0940 1101 cmpb #31,16(sp) prec >= 31? 
24 «614 «(0944 1136 75$: botr 90$ :if gtr, no, use common 
E7 19 0946 110 blss 50$ :if Uss, invalid src prec 
50 OC AE 7D 0948 11046 mova 12(sp),r0 sset src addr and prec 
53 of DO 094C 1105 movl (sp),r fry digs in frac 
| re D1 O94F 1106 cmpl r3,#31 rying to print more than 31 digs? 
DB 414 0952 1107 bgtr 50 f gtr, then yes, invalid format 
53 53 08 78 0954 1108 ashl #8,r3,r3 al digs in frac as scale 
53 1F 90 0958 1109 movb {,r3 suse max fixd prec 
5E 10 C2 0958 1110 subl #16,sp zget room for fixd temp 
52. SE) )=— Os sOO9SE =1111 mo. | ” hy oa :set addr of tmp 
00000000'GF 00 FB 0961 1116 cal.s #0, g*pli$fixdfixd_ré sconvert fixd to fixd tmp 
30 0631) «30968 «(111 brb 11 gcont 
50 OC AE 7D O96A 1114 908: movq fhe et src addr and prec 
54 03 O8 AE Ci OQO96E 1115 addl3 C305 gf weve _k_dst_fixd, r4” reat case index 
a. oF & Fy Sez W1% addl3 iget digs in frac + 1 
1F 653) D1 S977 «1117 cmpl trying to print more than 31 digits? 
03 15 O97A 1118 bleq 1068 tif leg, no 
F827 32031 «2097C «1119 brw roviceers tinvalid format 
53 53 08 78 OQ97F 1120 100$: ashl tuse digs in frac + 1 as scale 
53 1F 90 0983 1121 movb a3 ?* sset max fixd prec 
5E 10 C2 0986 1156 subl t16, 2 $P get room for fixd temp 
52 SE 00 0989 112 mov l spore :set addr of tmp 
O00000000'GF 00 FB Q98C 1124 calls : 9 “pli$cvrt_cg_r3 sconvert src to fixd 
5E 10 C2 0993 1125 subi 58 get room for another temp 
1F OS 10AE 1F- FF e F Boee 1126 ashp et #31 -16(sp),45,431,(sp) sround temp 
08 AE 8E 7D QO99F 1127 mov (sp)+,8(sp) ee to orig temp 
08 AE BE 7D O9A3 1198 movg __(sp)+.B(sp) 2 . 
O9A 1162 110$: ;at this point stack Looks Like 
9A7 1130 ; O(sp) - rounded 1 ixd(31 "bles | in frac) temp 
9A7 1131 3: 16(sp) ~ dis, in frac 
O9A7 1136 ; O(sp) - 
O9A7 11 : 24(sp) - src data type 
O9A7 1134 3; 28(sp) - src addr 
O9A7 1135 : 32(sp) - src prec 
9A7 11 § 3; 356(sp) = return addr 
5E 00 A? 11 mov so,r0 sset addr of fixd temp src 
51 10 AE 08 9AA 1138 ashl #8,16(sp),r1 suse digs in frac as scale 
1F 90 O9AF 1139 movb #31rl suse 31 as prec of fixd src 


PLISFORMAT 16-SEP-1984 02:18:05 VAX/VMS Macro V04-00 Page 21 
5 +O06 et 11:37:47 (CPLIRTL.SRCIPLIFORMAT.MAR; 1 (1) 
ee 9Bz 1140 subl #34, get space for char tem 
3 D 985 1141 mov s 23° eset her temp addr of dst 
D 98 1128 mov | a8h.r3 Z set 34 as len 
00000000 ' GF Fe 388 114 calls # gpl tet tadcher re sconvert fixd to char 
56 36 AE OD 9C2 1144 movl 54 (Sp ro iget wi 
18 AB 38 BO Q9C6 1145 movw r6,str_b_field(r11) set width in field 
56 22 D1 O9CA 1146 cmplL © #34.,.r6 twidth < 34? 
a Bare 114 blss 140 :if iss, no 
54 ¢¢ 56 gS OCF 1148 subl3 76,#34,r4 sget number of leading blanks 
6E 4 20 4 949) 1149 skpc #*x20,°4, (sp) Skip pooetns blanks 
03 13 0907 1150 beql 120$ sif ogt con 
F7CA 1 3444 113) brw orate tand fail 
1A AB 61 56 8 O9DC 11 § 120$: movc3 8 ir’ <str_b_field+2>(r11) scopy result to field 
SE 46 AE 3 O9E1 1153 1350$: movab 70(sp),sp clean stack 
00000000'GF 17 O9ES 115% jmp g-plisSputnedi_ré tput it out 
51 56 22 C3 OQ9EB 1155 140$: subl3 34,r6,r1 sget number of blanks needed 
1A AB 51 20 6€ O00 2C OQOSEF 1156 movcS #0 (sp5 ough ert cate bt eld+2>(r11) ;put in leading blanks 
65 6€ 22 28 O9F6 1157 moves) #34, (sp), (r3) scopy the result to field 
E5 11 O9FA 1158 brb 130$ cont 
O9FC 1159 
O9FC 1160 ; Line format 
03 OC AC 17 4 O9FC 1161 putline:bbc #Watr_vistring, fcb_l_attr(ap) ,5$ ;if string i/o 
F7AC 1 QA01 1166 brw invstrfmt | sfail with invalid string format 
OA 0C AC O7 £0 OQA0S 1163 5S: bbs #atr_v_print,fcb_l_attr(ap),10$ ;if print, cont 
50 00000000'8F 4 QAO9 1164 mov L #pli$_notprint,r0 sset not print file 
FB13 1 OA1O0 1165 brw fail sand fail 
FA8A 30 OA13 1166 10S: bsbw get_format_parm sget the parm | 
00000000'GF 16 OAI16 1167 sb g*pli$$putTine_ré6 process the Line 
FB1ID 31 OAIC 1168 rw pli$$put fmt_ré 390 again 
OAIF 1169 
OAIF 1170 ; p format output 
FA7E 30 OQAIF 1171 putp:  obsbw ogt..fornet_pars iget the pict desc 
03 12 OA22 1126 bneq 10$ :if neq, cont 
F775 331 OA24 S117 brw invfrm ifail 
52 18 AB QE OQA27 1174 108: movab str_b_field(r11),r2 set dst addr 
53 DO QOA2B 1175 mov rir ; sset addr of pict desc : 
82 04 Al 9B OA2ZE 1176 movzbw pic$b_byte_size(ri),(r2)+ ;set size of resulting string 
54 8€ 00 C1 OA32 1177 addl3 cvt_k_dst_pic,(sp)+,r4 ;set data type 
50 8& 7D OA36 1178 movg (sp)+,r0 sset addr, size of src 
00000000'GF 00 4 QA39 1179 calls #2 -9 pi tScurt_cg r3 sconvert to pic 
00000000'GF 1 pase 1180 mp g*pli$$putned7_ré zput it out 
0A46 1186 ; page format : : a: 
03 OC AC 17 4 A46 a putpage:bbc #atr_vistring, fcb_l_attr(ap) ,5$ ;if string i/o. 
F76 1 QASB 1184 brw invstrfmt :fail'with invalid string format 
OA OC AC QO EO OASE 1185 5$: bbs #atr_v_print,fcb_l_attr(ap),10$ ;if print, cont 
50  00000000'8F 09 OAS 1186 mov l #pLi$_notprint,r0 sset not print tile 
FAC 1 QASA 1187 brw fail sand fail 
00000000'GF 16 QAS5D 1188 10$: sb g“pli$S$putpage_ré6 :do a put page 
FAD6 31 OA63 1189 rw pli$Sputfmt_ré 3g0 again 
A66 1190 
A66 1191 ; skip format, output é eke 
03 OC AC 17 1 QA66 1138 putskip:bbc #atr_vistring, fcb_l_attr(ap) .5$ ;if string i/o 
F742 31 ~OA6B 119 brw invstrfmt :fail with invalid string format 
FA2A 0 QAGE 1194 5$: bsbw get_format_parm_1 get the number to skip 
52 1 00 QA71 1195 mov rit ; scopy number to skip 
00000000'GF 16 OA74 1196 jsb g*pli$$putskip_r2 :do the skips 


PLISFORMAT 
1-006 


6-SEP=1 PLIRTL.S TPLIFOR MAT.MAR; 1 


FABF 31 OQA7A 1197 brw Li$Sputfmt_ré 390 again 
AD 1198 este. i 
A7D 1199 ; tab format 
03 Of AC 17 1 QA7D 1200 puttab: bbc Water v string, fcb_l_attr(ap) ot if string i/o. 
re 1 QA82 1201 brw invstrfmt ie: h invalid string format 
FAI 0 QOA8S 1 o 5$: bsbw 96 t- format_parm_1 et We tab stop 
05 14 OA88 1 bgtr f gtr, cont 
$3 13° OABA 1204 beql 308 tif eql, go agai 
F71 : OA8C 1205 brw invfrmpr tits Lss, invalid format 
50. 2E Ac C OA8F 1 96 108: poveyl $5°-t- column ap), rd iget current column 
=. ce 0A93 120 bicl sround down to last tab stop 
52 2) 9 7 A97 1208 ashl 4 rt ek sget amor of blanks tor req tabs 
2 CO OA9B 1209 addl r3,r2 iget ending column 
522A AG B1 pars 1210 cmpw feb_w_linesize(ap),r2 past end of Aine? 
0 19 QAA2 1211 blss 20$ sif lss, yes, con 
51 52 50 C¢3 OQAAS 1 \¢ subl3. r0,r2,r1 get number of Slenke needed 
00C 31 OAAS 121 tw blank. field toutput blanks and go again 
00000000'GF 16 QOAAB 1214 gos: sb g*pliS$putskp1_r2 3do a skip 
FA88 31 QABI 1215 30S: rw pli$Sputfmt_ré6”- 390 again 
OAB4 1216 
OAB4 1217 ; x format, output 
F9ES 30 OAB4 1si8 putx: bsbw get. forset parm_1 zget the number of blanks 
OAB7 1219 ; brw Lank_field ;put out blanks and go again 
OAB7 1220 
0AB7 ssi 3¢ 
QOAB7 1 $6 sblank_field 
QAB? 1223 ; this routine puts the specified number of blanks in to the field in vcha 
QAB? 1224 ; format. it then calls pli$$putnedi_r6 and jumps to pliS$put int. ré. 
0AB7 165? 3 inputs: 
OAB7? 1226 ; rl = number of blanks 
OAB7? 1227 ; outputs: 
QOAB7 1228 ; 
OAB7? 1229 ; side gttectes 
OAB7 1230; rO-r4,r6 are destroyed 
OAB7 1231 : r5 is preserved for the offset to bit sources 
0AB7 \S36 
OAB? 123 blank. field: 
55 DD OQOAB7 1234 pushl fr5 ;save r5 in case a bit src is pending 
OOOOO3E8 8F 51 D1 OABY 1235 cmpl r1,#1000 itrying to put too many blanks in? 
OA 15 OACO 1236 bleq 1 if leg, no 
50 00000000'8F pO OAC2 1237 movl #pli$_strovfl,r0 ‘eet field overflow 
F 31 OAC9 1238 brw fail sane ses 
18 AB 51 =F? OACC 1239 10S: cvtlw ori, etr b Pigietett) ize of string 
1A AB 51 20 6€ QO 2 pane 1240 movc5 #0, (spt. A*x20,r1,str_b_ tieldeaceil 1) ;put in the blanks 
00000000'GF 16 OAD? 1241 jsb g*pli fam ré soutput the field 
5 B8EDO OADD ists popt r5 restore r 
FAS9 31 QAEO 124 rw pl i$Sput fmt_r6 390 on to next format 
QOAES 1244 
QAES 1245 ;+ 
OAES 1 ‘6 ; 
QAES 1247 ; char_flt_ctx 
OAES 1248 ; 
AES 1249 ; finds the appropriate float decimal precision for a character 
AES 1 29 ; string based on the number of digits in the mantissa and 
QAE ! 50 3; the value of the exponent. 
1253 ; 


inputs: 
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PLISFORMAT 16-SEP-1984 02:18:05 VAX/VMS Macro v04-00 Page 
1-006 eet 95533 :03 LPLIRTL. SREIPLIFORMAT MAR: 1 . 
OAE3 1254 ; 
AES 1 2? 3 rl - string size 
AES 1 § ; r0 = string addr 
3 : 2f ; ap - addr of file control block 
AES 1259 ; outputs: 
AES 1260 ; 
“| : ) 3 returns the precision in r3 
AES 1 § ; all other registers preserved 
OAES 1264 ; 
AES 1265 ;- 
AES 1 oe char_flt_ctx: 
05 OC AC 1A €1 OAES 126 Bbc #atr_v_flttrg,fcb_l_attr(ap),.4$ ;if flt target 
53 10 AE DO OAEB 1268 movi 16(sp)7r3 rset fltb prec of target 
05 OAEC 1269 rsb sreturn 
37 BB OQAED 1270 4$ pushr #*m<r0,r1,r2,r4,r5> 3; save regs 
60 51 20 38 OAEF 1271 skpc #32, r 1, (0) ; skip leading blanks 
05 12 OAF3 1 ie: bneq 5$ : if string not blank, br 
54 01 DO OAFS 127 movl #174 ; else set prec of 
7A 11 Oar 1303 brb 100$ 
52 50 7D OAFA 1276 5$ movq 0, r2 ; save new addr and Length from skip 
63 50 20 3A OQAFD 1277 loce #32,r0, (r3) ; throw out trailing blanks too 
52 50 C2 0801 1278 subl r0,r ; find the number of non-blank chars 
28 «663)~—=691)S—(0B04 «1279 cmpb (r3) ,#*a/+/ ; check for a sign 
05 13 08607 1500 beql ; br if. found 
20 63 91 OB09 1281 cmpb (r3) ,#*a/-/ 3; minus? 
04 12 OB0C 1e8¢ bneq 20$ ; br if no sign 
53 D6 OBOE 1283 10$: incl r3 3; point past it 
52 D7? 0B10 1284 decl re eel 
54 52 00 OB12 1285 20S: movl r2,r4 ; make char. count the digit count 
63 52 2— 3A 0B15 1¢86 locc #*a/./,r2,(r3) ; check for decimal point 
02 13 0B19 1287 beql 30$ ; br if none ee 
54 D7 OBIB 1288 decl r4 3; deduct dec. pt. from digit count 
63 52 45 8F 3A OQB1D 1289 30$: locc #*a/E/,r2,(r3) : look for E 
07 12 OB22 1930 bneq ; br if found 
63 52 65 8F 3A 0B24 1291 loce #*a/e/,r2,(r3) : @? . 
49 13 0B29 1936 beql 100$ : if none, that's it ro 
54 50 C2 OB2B 1295 40$: subl r0,r4 3; sub. exponent chars from digit count 
51 D6 OBZ2E 1294 cl ri 3 point past the E/e 
50 D7 08 1295 decl r0 ; 
28 «661—Cs«é@S9'1s«éOWB 1296 cmpb (r1) ,#%a/+/ 3; check for exponent sign 
05 13 3 1297 beql ; br if found 
2 61. 9 1298 cmpb (r1) ,#*a/-/ 3 minus? ‘ 
04 12 OB3A 1299 bneq 50$ ; br if no sign . 
os. we pBsc 1300 45$: incl ri : point past the sign char 
50 07 1301 decl rd 
- = 4 1306 50$: cmpl r4,4#15 ; is prec. huge? 
2F «14 0B43 1 bgtr 1008 ; if so, that’s it 
45 1304 ; else, get exponent value 
es: @ tz 45 1305 subl r0,sp 3 get a stack temp 
11 by) 48 1 88 pushr #*m<r0,r4> ; Save some regs 
08 AE 61 50 2 4A 1 movc3 r0,(r15,8(sp) 3 copy exp. digits to temp 
11 BA 4F 1 3 popr #*m<r0,r4> 3 restore regs 
7E C Q0B51 1 clrq 743") ; more temps _ 
07 AE 20 90 0853 1310 movb #32,7(sp) ; make a leading sep. string 


PLISFORMAT :0 AX/VMS o V04-00 Page 24 | 
ee tt =}38% oF: 8: 03 Yon TRTE SPLIFORMAT MAR: 1 ° (1) 
0 D OBS7 1311 ushl ; save size 
08 AE 04 OB AE 26 03 B59 1 1g evtsp . 4B so8 ts #4, htop ; cvrt exponent to packed 
04 AE 9 a F 3 acy } F sa (sp) sd : sees pens oie 9 
cm ; see exponent is huge 
4 : 00 Bet : 1 tlea oo 4 ; at “yt or ; 
mov r ; plug max. nuge prec. 
2 gE ce +H ! i 60$: oe ee 3 Plesn off the stack’ 
clraq 
74 1319 1008: 
53 36 dO 74 1320 movl r4,r3 3; return result in r3 
7 BA 0877 1321 popr yemcr0,r1,r2.r6,75> 3 restore regs 
05 79 «1 ¢ rs 
B7A 1 
OB7A 1324 end 
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Psect synopsis 66-SEP-1984 11:37: PLIRTL.S LIFORMAT.MAR; 1 (1)) 
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PSECT name Allocation PSECT No. Attributes 

— 2 % 00000000 0.) 00 ¢ O.) NOPIC USR CON ABS LCL NOSHR NOEXE NORD NOWRT NOVEC BYTE | 

SABSS 00000C08 ( 3080.) 01 (¢ 1.) NOPIC USR CON ABS LCL NOSHR EXE RD WRT NOVEC BYTE 

_PLISCODE Q0000B7A ( 2938.) 02 ¢ 2.) PIC USR CON REL LCL SHR EXE RD NOWRT NOVEC LONG | 
Pew mommeooceweeececceececn} 
! Performance indicators : | 

Phase Page faults CPU Time Elapsed Time | 

Initialization 9 00:00:00.08 00:00:01.23 

Command processing 73 00:00:00.51 00:00:03.45 

Pass 210 00:00:08.45 00:00:26.43 

Symbol table sort 0 00:00:00.74 00:00:01.18 

Pass 2 244 00:00:03.09 00:00:06.34 

Symbol table output 19 00:00:00.16 Bo BS BR +26 

Psect synopsis output 2 00:00:00.03 00:00:00.0 

Cross-reference output 0 00:00:00.00 00:00:00.00 

Assewwler run totals 557 00:00:13.06 00:00:39.18 


The working set Limit was 1350 pages. i ; 

49255 bytes (97 pages) of virtual memory were used to buffer the intermediate code. 

There were 30 pages of symbol table space allocated to hold 338 non-local and 154 local symbols. 
1324 source Lines were read in Pass 1, produc ing 21 object records in Pass 2. | 
19 pages of virtual memory were used to define 17 macros. 


+ 
' Macro Library statistics ! 
¢ eww ener re ee ee seen eee ee senso es + 


Macro Library name Macros defined | 
_$255$DUA28: CPLIRTL.OBJJPLIRTMAC.MLB; 1 7 
$255$DUA28: CSYSLIBISTARLET.MLB;2 6 | 
TOTALS (all Libraries) 13 | 


295 GETS were required to define 13 macros. 
There were no errors, warnings or information messages. 
MACRO/ENABLE=SUPPRESSION/DISABLE=TRACEBACK/LIS=LIS$:PLIFORMAT/OBJ=OBJ$:PLIFORMAT MSRC$:PLIFORMAT/UPDATE=(ENHS$:PLIFORMAT)+LIB$:PLIRTM 
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